HPAVC/HPAVC CD-ROM.iso/pc/CONTRSRC.ZIP/SRC/SETUP/WIN2.PAS

Pascal/Delphi Source File | 1994-09-29 | 40.8 KB | 951 lines

{***************************************************************************
*  WinDummy : appelé par un Close sur la variable fichier OUTPUT           *
**------------------------------------------------------------------------**
*  Entrée : F = variable fichier Output de type TextRec                    *
*  Sortie : Doit renvoyer 0 par définition (= pas d'erreur)                *
*  Variables globales : néant                                              *
***************************************************************************}

{$F+}    { doit être FAR }

function WinDummy( var f : TextRec ) : integer;

begin
  WinDummy := 0;    { Retourne systématiquement 0 }
end;

{$F-}

{***************************************************************************
*  WinWriteln : déclenché par Turbo Pascal lors d'un appel à WRITE ou      *
*               WRITELN associé à la variable fichier OUTPUT               *
**------------------------------------------------------------------------**
*  Entrée : F = variable fichier Output de type TextRec                    *
*  Sortie : Doit renvoyer 0 par définition (= pas d'erreur)                *
*  Variables globales : Write2View/R, WritelnX/RW, WritelnY/RW,            *
*                       WritelnPtr/RW, ViewX1/R, ViewY1/R, ViewX2/R,       *
*                       ViewY2/R                                           *
***************************************************************************}

{$F+}   { Doit être FAR }

function WinWriteln( var f : TextRec ) : integer;

var i    : integer;    { Compteur d'itérations }
    Carptr : BPTR;     { Pointe sur le caractère à afficher  }

begin
  with f do    { Traite la variable fichier }
    begin
      Carptr := BPTR( BufPtr );  { Pointe sur le premier caractère }
      if ( Write2View ) then  { Faut-il tenir compte de la zone de visualisation ? }
        begin  { Oui, fait éventuellement défiler la zone }
          for i := 1 to BufPos do { Parcourt les caractères }
            begin
              case Carptr^ of   { Traite le caractère courant }

                7 : begin    { BEL : Emet un signal sonore }
                      Sound( 880 );  { Lance le signal }
                      Delay( 750 );  { Attend 3/4 seconde }
                      NoSound;   { Coupe le signal }
                    end;

                8 : begin   { Backspace (BS): Revient en arrière }
                      if ( WritelnX = ViewX1 ) then { Début de ligne ? }
                        begin   { Oui, revient à la ligne précédente }
                          WritelnX := ViewX2;  { en dernière colonne }
                          dec( WritelnY );      { de la ligne préc.  }
                        end
                      else   { Même ligne }
                        dec( WritelnX );  { Recule d'une colonne }
                      WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                    end;

               10 : begin     { Linefeed (LF): Incrémente la ligne d'affichage  }
                      if ( WritelnY = ViewY2 ) then { Est-ce la dernière ligne de la zone de visualisation ? }
                        WinScrollUp( ViewX1, ViewY1+1, ViewX2,
                                     ViewY2, 1, WritelnCol )
                      else   { Pas besoin de faire défiler la zone de visualisation }
                        begin
                          inc( WritelnY );
                          WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                        end;
                    end;

               13 : begin             { CR: Revient au début de la ligne }
                      WritelnX := ViewX1;
                      WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                    end;

               else   { Autre caractère : affiche tel quel }
                 begin
                   {-- Ecrit le code ASCII et l'attribut en mémoire vidéo--}

                   WritelnPtr^.Caractere := Carptr^;
                   WritelnPtr^.Attribut := WritelnCol;

                   {-- Avance le pointeur sur le caractère suivant -------}

                   inc( PTRREC( WritelnPtr ).Ofs, 2 );
                   inc( WritelnX );  { Incrémente la colonne }
                   if ( WritelnX > ViewX2 ) then  { Limite de la zone de visualisation ? }
                     begin  { Oui  }
                       WritelnX := ViewX1;  { Ligne suivante }
                       if ( WritelnY = ViewY2 ) then  { Est-ce la dernière de la zone de visualisation ?}
                         begin  { Oui, fait défiler la zone }
                           WinScrollUp( ViewX1, ViewY1+1, ViewX2,
                                        ViewY2, 1, WritelnCol );
                           WritelnX := ViewX1;  { Bord gauche }

                           WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                         end
                       else  { Pas besoin de faire défiler la zone de visualisation }
                         begin
                           inc( WritelnY );
                           WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                         end;
                     end;
                 end;
              end;
              inc( PTRREC( Carptr ).Ofs );{ Pointe sur le caractère suivant }
           end;
        end
      else   { Ne tient pas compte de la zone de visualisation , écrit simplement dans la mémoire vidéo }
        begin
          for i := 1 to BufPos do  { Parcourt les caractères }
            begin
              case Carptr^ of   { Traite le caractère courant }

                7 : begin  { BEL : Emet un signal sonore }
                      Sound( 880 ); { Lance le signal  }
                      Delay( 750 ); { Attend 3/4 seconde }
                      NoSound;      { Coupe le signal }
                    end;

                8 : begin  { Backspace (BS): Revient en arrière }
                      if ( WritelnX = 0 ) then { Début de ligne ? }
                        begin          { Oui, revient à la ligne précédente }
                          WritelnX := NbCol - 1;  { en dernière colonne }
                          dec( WritelnY );       { de la ligne }
                        end
                      else                  { Même ligne }
                        dec( WritelnX );     { Recule d'une colonne }
                      WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                    end;

               10 : begin     { Linefeed (LF): Incrémente la ligne d'affichage }
                      inc( WritelnY );
                      WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                    end;

               13 : begin             { CR: Revient au début de la ligne }
                      WritelnX := 0;
                      WritelnPtr := GetVioPtr( WritelnX, WritelnY );
                    end;

               else           { Autre caractère : afficher tel quel }
                 begin
                   {-- Ecrit le code ASCII et l'attribut en mémoire vidéo--}


                   WritelnPtr^.Caractere := Carptr^;
                   WritelnPtr^.Attribut := WritelnCol;

                   {-- Avance le pointeur sur le caractère suivant --------------}

                   inc( PTRREC( WritelnPtr ).Ofs, 2 );
                   inc( WritelnX );   { Incrémente la colonne }
                   if ( WritelnX = NbCol ) then    { Fin de ligne ? }
                     begin   { Oui  }
                       WritelnX := 0;   { Passe à la suivante }
                       inc( WritelnY );
                     end;
                 end;
              end;
              inc( PTRREC( Carptr ).Ofs );{ Pointe sur le caractère suivant }
           end;
        end;
      BufPos := 0;    { Tous les caractères ont été traités }
    end;
  WinWriteln := 0;  { Retourne 0 }
end;

{$F-}

{***************************************************************************
*  OutputOpen : déclenché par Turbo Pascal au premier appel de WRITE       *
*               ou de WRITELN, après que la variable fichier Output        *
*               ait été détournée par WinInit                              *
**------------------------------------------------------------------------**
*  Entrée : F = variable fichier Output de type TextRec                    *
*  Sortie : Doit renvoyer 0 par définition (= pas d'erreur)                *
*  Variables globales : néant *                                            *
****************************************************************************}

{$F+} { Doit être FAR }

function OutputOpen( var f : TextRec ) : integer;

begin
  with f do      { Traite la variable fichier }
    begin
      InOutFunc := @WinWriteln; { Fixe l'adresse de la fonction de sortie }
      FlushFunc := @WinWriteln; { "Flush" correspond ici à "Out" }
      CloseFunc := @WinDummy;   { Close n'est pas pris en compte  }
    end;
  OutputOpen := 0;  { Retourne systématiquement 0 }
end;

{$F-}

{**************************************************************************
*  ScrollHori : fait défiler une zone de l'écran                          *
*               d'un certain nombre de colonnes                           *
*               vers la gauche ou la droite                               *
**-----------------------------------------------------------------------**
*  Entrées :x1, y1    = Coordonnées du coin supérieur gauche de la zone   *
*           x2, y2    = Coordonnées du coin unférieur droit de la zone    *
*           Nombre    = Nombre de colonnes à décaler                      *
*           Couleur   = Couleur où attribut des colonnes libérées         *
*           AGauche   = TRUE  : Défilement vers la gauche                 *
*                       FALSE : Défilement vers la droite                 *
*  Information        : Si la couleur est égale à la constante NO_CLEAR,  *
*                       les colonnes libérées ne sont pas effacées        *
*  Variable globale   : LigneOfs/R                                        *
**************************************************************************}

procedure ScrollHori( x1, y1, x2, y2, Nombre, Couleur : byte;
                         AGauche : boolean );

var de,         { Copie de ... }
    a   : VPTR; { ... à }
    Byte2Copy,  { Nombre d'octets par ligne }
    ActLigne  : integer;   { Ligne actuelle }

begin
 Byte2Copy := (x2 - x1 + 1) shl 1;  { Nombre d'octets }
 de := GetVioPtr( x1, y1 );
 if AGauche then     { Vers la gauche ?  }
   a := GetVioPtr( x1 - Nombre, y1 ) { Oui }
 else    { Vers la droite  }
   a := GetVioPtr( x1 + Nombre, y1 );

 for ActLigne := y1 to y2 do    {  Parcourt les lignes }
   begin
     Move( de^, a^, Byte2Copy );  { Copie la ligne }
     inc( PTRREC( de ).Ofs, LigneOfs );
     inc( PTRREC( a ).Ofs, LigneOfs );
   end;

 {-- Efface éventuellement les colonnes libérées -----}

 if Couleur <> NO_CLEAR then  { Efface ?  }
  if AGauche then   { Vers la gauche  }
    WinFill( x2-Nombre+1, y1, x2, y2, ' ', Couleur)
  else   { Vers la droite }
    WinFill( x1, y1, x1+Nombre-1, y2, ' ', Couleur);
end;

{**************************************************************************
*  WinScrollDown : fait défiler une zone de l'écran                       *
*                 d'un certain nombre de lignes vers le bas               *
**-----------------------------------------------------------------------**
*  Entrées : x1, y1 = Coordonnées du coin supérieur gauche de la zone     *
*            x2, y2 = Coordonnées du coin inférieur droit de la zone      *
*            Nombre = Nombre de lignes à remonter                         *
*            Couleur = Couleur ou attribut des lignes libérées            *
*  Information    : Si la couleur est égale à la constante NO_CLEAR,      *
*            les lignes libérées ne sont pas effacées                     *
*  Variables globales : LigneOfs/R                                        *
**************************************************************************}

procedure WinScrollDown( x1, y1, x2, y2, Nombre, Couleur : byte );

var de,    { Copie de ...}
    a    : VPTR;   { ... à }
    Byte2Copy,   { Nombre d'octets par ligne }
    ActLigne  : integer; { Ligne actuelle }

begin
 Byte2Copy := (x2 - x1 + 1) shl 1;   { Nombre d'octets }
 de  := GetVioPtr( x1, y2 );  { Pointe sur la ligne à déplacer }
 a   := GetVioPtr( x1, y2 + Nombre );  { Nouvelle position }

 for ActLigne := y1 to y2 do    { Parcourt les différentes lignes  }
   begin
     Move( de^,a^, Byte2Copy ); { Copie la ligne }
     dec( PTRREC( de ).Ofs, LigneOfs );
     dec( PTRREC( a  ).Ofs, LigneOfs );
   end;

 if Couleur <> NO_CLEAR then  { Efface les lignes libérées ? }
   WinFill( x1, y1, x2, y1+Nombre-1, ' ', Couleur);    { Oui }
end;

{**************************************************************************
*  WinScrollUp : fait défiler une zone de l'écran                         *
*                 d'un certain nombre de lignes vers le haut              *
**-----------------------------------------------------------------------**
*  Entrées : x1, y1 = Coordonnées du coin supérieur gauche de la zone     *
*            x2, y2 = Coordonnées du coin inférieur droit de la zone      *
*            Nombre = Nombre de lignes à remonter                         *
*            Couleur = Couleur ou attribut des lignes libéréess           *
*  Information    : Si la couleur est égale à la constante NO_CLEAR,      *
*            les lignes libérées ne sont pas effacées                     *
*  Variables globales : LigneOfs/R                                        *
***************************************************************************}

procedure WinScrollUp( x1, y1, x2, y2, Nombre, Couleur : byte );

var de,     { Copie de ... }
    a      : VPTR;   { ... à }
    Byte2Copy,    { Nombre d'octets par ligne }
    ActLigne  : integer; { Ligne actuelle }

begin
 Byte2Copy := (x2 - x1 + 1) shl 1;   { Nombre d'octets }
 de   := GetVioPtr( x1, y1 );    { Pointe sur la ligne à déplacer }
 a    := GetVioPtr( x1, y1 - Nombre ); { Nouvelle position}

 for ActLigne := y1 to y2 do  { Parcourt les différents caractères }
   begin
     Move( de^,a^, Byte2Copy );  { Copie la ligne }
     inc( PTRREC( de  ).Ofs, LigneOfs );
     inc( PTRREC( a  ).Ofs, LigneOfs );
   end;

 if Couleur <> NO_CLEAR then   { Efface les lignes libérées ? }
   WinFill( x1, y2+1-Nombre, x2, y2, ' ', Couleur);    { Oui }
end;

{***************************************************************************
*  WinScrollLeft : fait défiler une zone de l'écran                        *
*                  d'une certain nombre de colonnes vers la gauche         *
**------------------------------------------------------------------------**
*  Entrées : cf WinScrollUp, WinScrollDown                                 *
*  Variables globales : néant                                              *
***************************************************************************}

procedure WinScrollLeft( x1, y1, x2, y2, Nombre, Couleur : byte );

begin
  ScrollHori( x1, y1, x2, y2, Nombre, Couleur, TRUE );
end;

{***************************************************************************
*  WinScrollRight: fait défiler une zone de l'écran                        *
*                  d'un certain nombre de colonnes vers la droite          *
**------------------------------------------------------------------------**
*  Entrées : cf WinScrollUp, WinScrollDown                                 *
*  Variables globales : néant                                              *
***************************************************************************}

procedure WinScrollRight( x1, y1, x2, y2, Nombre, Couleur : byte );

begin
  ScrollHori( x1, y1, x2, y2, Nombre, Couleur, FALSE );
end;

{***************************************************************************
*  WinMoveUp : déplace la fenêtre active vers le haut                      *
**------------------------------------------------------------------------**
*  Entrée : Nombre = Nombre de lignes du déplacement                       *
*  Information     : le programme appelant doit s'assurer que la fenêtre   *
*                    ne sort pas des limites de l'écran                    *
*  Variables globales : vLigne/RW, vColonne/RW, Write2View/R, ViewY1/W,    *
*                       ViewY2/W, WritelnY/W                               *
***************************************************************************}

procedure WinMoveUp( Nombre : byte );

var BufPtr : VPTR;  { Pointe sur un buffer de travail }
    Largeur,  { Nombre de colonnes de la fenêtre }
    Hauteur,  { Nombre de lignes de la fenêtre }
    BufLen : integer;  { Taille du buffer de travail en octets }

{-- GetPtr est une fonction locale qui renvoie un pointeur sur le début d'une ligne dans le buffer de la fenêtre active --}

function GetPtr( Ligne : integer ) : pointer;

begin
  GetPtr := @ActBufPtr^[ Ligne * Largeur ];
end;

{-------------------------------------------------------------------------}

begin
  with ActWinPtr^ do    { Accède au descripteur de la fenêtre active }
    begin
      Largeur := x2 - x1 + 1;
      Hauteur := y2 - y1 + 1;
      BufLen := Largeur * Nombre shl 1;
      GetMem( BufPtr, BufLen );   { Alloue un buffer temporaire }
      GetScr( x1, y1-Nombre, x2, y1-1, BufPtr );
      WinScrollUp ( x1, y1, x2, y2, Nombre, NO_CLEAR );
      PutScr( x1, y2-Nombre+1, x2, y2, GetPtr( Hauteur - Nombre ) );
      Move( GetPtr( 0 )^, GetPtr(Nombre)^, Largeur * (Hauteur-Nombre) shl 1);
      Move( BufPtr^, GetPtr( 0 )^, BufLen );

      {-- Si le curseur se trouve à l'intérieur de la fenêtre, il doit  -}
      {-- aussi être déplacé                                            -}

      if ( (x1 <= vColonne ) and (x2 >= vColonne ) and
           (y1 <= vLigne ) and (y2 >= vLigne ) ) then
        WinSetCursor( vColonne , vLigne - Nombre );

      {-- En mode Write2View, la position d'affichage pour Write et ------}
      {-- Writeln doit être recalée -------}

      if ( Write2View ) then   { Est-on en mode Write2View ? }
        begin   { Oui  }
          dec( WritelnY, Nombre );   { Ajuste la position }
          WritelnPtr := GetVioPtr( WritelnX, WritelnY );
        end;

      dec( y1, Nombre );    { Met à jour les coordonnées de la fenêtre }
      dec( y2, Nombre );
      FreeMem( BufPtr, BufLen ); { Libère le buffer temporaire }
    end;
  dec( ViewY1, Nombre );   { Déplace la zone de visualisation }
  dec( ViewY2, Nombre );
end;

{***************************************************************************
*  WinMoveDown : déplace la fenêtre active vers le bas                     *
*                                                                          *
**------------------------------------------------------------------------**
*  Entrée : Nombre = Nombre de lignes du déplacement                       *
*  Information    : le programme appelant doit s'assurer que la fenêtre ne *
*                   sort pas des limites de l'écran                        *
*  Variables globales : vLigne/RW, vColonne/RW, Write2View/R, ViewY1/W,    *
*                       ViewY2/W, WritelnY/W                               *
***************************************************************************}

procedure WinMoveDown( Nombre : byte );

var BufPtr : VPTR;  { Pointe sur un buffer de travail }
    Largeur,   { Nombre de colonnes de la fenêtre }
    Hauteur,   { Nombre de lignes de la fenêtre }
    BufLen : integer;  { Taille du buffer de travail en octets }

{-- GetPtr est une fonction locale qui retourne un pointeur sur le début d'une ligne dans le buffer de la fenêtre active -- }

function GetPtr( Ligne : integer ) : pointer;

begin
  GetPtr := @ActBufPtr^[ Ligne * Largeur ];
end;

{--------------------------------------------------------------------------}

begin
  with ActWinPtr^ do  { Accède au descripteur de la fenêtre active }
    begin
      Largeur := x2 - x1 + 1;
      Hauteur := y2 - y1 + 1;
      BufLen := Largeur * Nombre shl 1;
      GetMem( BufPtr, BufLen );  { Alloue un buffer temporaire }
      GetScr( x1, y2+1, x2, y2+Nombre, BufPtr );
      WinScrollDown( x1, y1, x2, y2, Nombre, NO_CLEAR );
      PutScr( x1, y1, x2, y1+Nombre-1, GetPtr( 0 ) );
      Move( GetPtr(Nombre)^, GetPtr( 0 )^, Largeur * (Hauteur-Nombre) shl 1);
      Move( BufPtr^, GetPtr( Hauteur - Nombre )^, BufLen );

      {-- Si le curseur se trouve à l'intérieur de la fenêtre, il doit  -}
      {-- aussi être déplacé                                            -}

      if ( (x1 <= vColonne ) and (x2 >= vColonne ) and
           (y1 <= vLigne ) and (y2 >= vLigne ) ) then
        WinSetCursor( vColonne , vLigne + Nombre );

      {-- En mode Write2View, la position d'affichage pour Write et ------}
      {-- Writeln doit être recalée -------}

      if ( Write2View ) then  { Est-on en mode Write2View ? }
        begin  { Oui }
          inc( WritelnY, Nombre );   { Ajuste la position }
          WritelnPtr := GetVioPtr( WritelnX, WritelnY );
        end;

      inc( y1, Nombre ); { Met à jour les coordonnées de la fenêtre }
      inc( y2, Nombre );
      FreeMem( BufPtr, BufLen );  { Libère le buffer temporaire }
    end;
  inc( ViewY1, Nombre );   { Déplace la zone de visualisation  }
  inc( ViewY2, Nombre );
end;

{***************************************************************************
*  WinMoveRight : déplace la fenêtre active vers la droite                 *
**------------------------------------------------------------------------**
*  Entrée : Nombre = Nombre de colonnes du déplacement                     *
*  Information    : le programme appelant doit s'assurer que la fenêtre ne *
*                   sort pas des limites de l'écran                        *
*  Variables globales : vLigne/RW, vColonne/RW, Write2View/R, ViewX1/W,    *
*                       ViewX2/W, WritelnX/W                               *
***************************************************************************}

procedure WinMoveRight( Nombre : byte );

var BufPtr,   { Pointe sur un buffer de travail }
    LBufPtr   : VPTR;  { Pointeur courant }
   Byte2Copy,  { Nombre d'octets à copier }
    Ligne,     { Compteur de lignes }
    EndLigne,  { idem }
    Largeur,   { Nombre de colonnes de la fenêtre }
    Hauteur,   { Nombre de lignes de la fenêtre }
    BufLen    : integer;  { Taille du buffer de travail en octets }

{-- GetPtr est une fonction locale qui retourne un pointeur sur le début d'une ligne dans le buffer de la fenêtre active -- }

function GetPtr( Ligne, Colonne : integer ) : pointer;

begin
  GetPtr := @ActBufPtr^[ Ligne * Largeur + Colonne ];
end;

{-------------------------------------------------------------------------}

begin
  with ActWinPtr^ do   { Accède à la fenêtre active }
    begin
      Largeur := x2 - x1 + 1;
      Hauteur := y2 - y1 + 1;
      BufLen := Hauteur * Nombre shl 1;
      GetMem( BufPtr, BufLen );  { Alloue un buffer temporaire }
      GetScr( x2+1, y1, x2+Nombre, y2, BufPtr );
      ScrollHori( x1, y1, x2, y2, Nombre, NO_CLEAR, FALSE );

      Byte2Copy := ( Largeur - Nombre ) shl 1;
      LBufPtr := BufPtr;   { Pointe sur le début du buffer }
      EndLigne := Hauteur - 1;
      for Ligne:=0 to EndLigne do  { Parcourt les lignes une à une }
        begin
          PutScr( x1, Ligne+y1, x1+Nombre-1, Ligne+y1,
                        GetPtr( Ligne, 0 ) );
          Move( GetPtr( Ligne, Nombre )^, GetPtr( Ligne, 0 )^, Byte2Copy );
          Move( LBufPtr^, GetPtr( Ligne, Largeur - Nombre )^, Nombre shl 1 );
          inc( PTRREC( LBufPtr ).Ofs, Nombre shl 1 );
        end;

      {-- Si le curseur se trouve à l'intérieur de la fenêtre, il doit  -}
      {-- aussi être déplacé                                            -}

      if ( (x1 <= vColonne ) and (x2 >= vColonne ) and
           (y1 <= vLigne ) and (y2 >= vLigne ) ) then
        WinSetCursor( vColonne + Nombre , vLigne );

      {-- En mode Write2View, la position d'affichage pour Write et ------}
      {-- Writeln doit être recalée -------}

      if ( Write2View ) then   { Est-on en mode Write2View ? }
        begin  { Oui }
          inc( WritelnX, Nombre );  { Ajuste la position d'affichage }
          WritelnPtr := GetVioPtr( WritelnX, WritelnY );
        end;

      inc( x1, Nombre ); { Met à jour les coordonnées de la fenêtre }
      inc( x2, Nombre );
      FreeMem( BufPtr, BufLen ); { Libère le buffer temporaire }
    end;
  inc( ViewX1, Nombre );   { Déplace la zone de visualisation }
  inc( ViewX2, Nombre );
end;

{***************************************************************************
*  WinMoveLeft : déplace la fenêtre active vers la gauche                  *
**------------------------------------------------------------------------**
*  Entrée : Nombre = Nombre de colonnes du déplacement                     *
*  Information    : le programme appelant doit s'assurer que la fenêtre ne *
*                   sort pas des limites de l'écran                        *
*  Variables globales : vLigne/RW, vColonne/RW, Write2View/R, ViewX1/W,    *
*                       ViewX2/W, WritelnX/W                               *
***************************************************************************}

procedure WinMoveLeft( Nombre : byte );

var BufPtr,   { Pointe sur un buffer de travail }
    LBufPtr   : VPTR;  { Pointeur courant }
    Byte2Copy,  { Nombre d'octets à copier }
    Ligne,      { Compteur de lignes }
    EndLigne,   { idem }
    Largeur,    { Nombre de colonnes de la fenêtre }
    Hauteur,    { Nombre de lignes de la fenêtre }
    BufLen    : integer;   { Taille du buffer de travail en octets }

{-- GetPtr est une fonction locale qui retourne un pointeur sur le début d'une ligne dans le buffer de la fenêtre active -- }

function GetPtr( Ligne, Colonne : integer ) : pointer;

begin
  GetPtr := @ActBufPtr^[ Ligne * Largeur + Colonne ];
end;

{-------------------------------------------------------------------------}

begin
  with ActWinPtr^ do  { Accède au descripteur de la fenêtre active }
    begin
      Largeur := x2 - x1 + 1;
      Hauteur := y2 - y1 + 1;
      BufLen := Hauteur * Nombre shl 1;
      GetMem( BufPtr, BufLen ); { Alloue un buffer temporaire }
      GetScr( x1-Nombre, y1, x1-1, y2, BufPtr );
      ScrollHori( x1, y1, x2, y2, Nombre, NO_CLEAR, TRUE );

      Byte2Copy := ( Largeur - Nombre ) shl 1;
      LBufPtr := BufPtr;  { Pointe sur le début du buffer }
      EndLigne := Hauteur - 1;
      for Ligne:=0 to EndLigne do  { Parcourt les lignes une à une  }
        begin
          PutScr( x2-Nombre+1, Ligne+y1, x2, Ligne+y1,
                        GetPtr( Ligne, Largeur - Nombre ) );
          Move( GetPtr( Ligne, 0 )^, GetPtr( Ligne, Nombre )^, Byte2Copy );
          Move( LBufPtr^, GetPtr( Ligne, 0 )^, Nombre shl 1 );
          inc( PTRREC( LBufPtr ).Ofs, Nombre shl 1 );
        end;

      {-- Si le curseur se trouve à l'intérieur de la fenêtre, il doit  -}
      {-- aussi être déplacé                                            -}

      if ( (x1 <= vColonne ) and (x2 >= vColonne ) and
           (y1 <= vLigne ) and (y2 >= vLigne ) ) then
        WinSetCursor( vColonne + Nombre , vLigne );

      {-- En mode Write2View, la position d'affichage pour Write et ------}
      {-- Writeln doit être recalée -------}

      if ( Write2View ) then   { Est-on en mode Write2View ? }
        begin   { Oui }
          dec( WritelnX, Nombre );  { Ajuste la position }
          WritelnPtr := GetVioPtr( WritelnX, WritelnY );
        end;

      dec( x1, Nombre ); { Met à jour les coordonnées de la fenêtre }
      dec( x2, Nombre );
      FreeMem( BufPtr, BufLen );  { Libère le buffer temporaire }
    end;
  dec( ViewX1, Nombre );  { Déplace la zone de visualisation }
  dec( ViewX2, Nombre );
end;

{***************************************************************************
*  WinMove : déplace la fenêtre active                                     *
*                                                                          *
**------------------------------------------------------------------------**
*  Entrées : x, y : Nouvelles coordonnées du coin supérieur gauche de la   *
*                   fenêtre                                                *
*  Information    : le programme appelant doit s'assurer que la fenêtre ne *
*                   sort pas des limites de l'écran                        *
*  Variables globales : vLigne/RW, vColonne/RW, Write2View/R, ViewX1/W,    *
*                     ViewX2/W, ViewY1/W, ViewY2/W, WritelnX/W, WritelnY/W *
*  Variable globale : néant                                                *
***************************************************************************}

procedure WinMove( x, y : byte );

var BufPtr : VPTR;   { Pointe sur un buffer temporaire }
    DeltaX,      { Distance entre l'ancienne et la nouvelle }
    DeltaY,      { position de la fenêtre }
    Largeur,     { Nombre de colonnes de la fenêtre }
    Hauteur,     { Nombre de lignes de la fenêtre }
    BufLen : integer;  { Taille du buffer temporaire en octet }

begin
  with ActWinPtr^ do  { Accède au descripteur de la fenêtre active }
    begin
      Largeur := x2 - x1;
      Hauteur := y2 - y1;
      BufLen := ( Hauteur + 1 ) * ( Largeur + 1 ) shl 1;
      GetMem( BufPtr, BufLen ); { Alloue un buffer temporaire }
      GetScr( x1, y1, x2, y2, BufPtr ); { Stocke la fenêtre active dans le tampon }
      PutScr( x1, y1, x2, y2, @Buffer ); { Restaure la zone recouverte }

      DeltaX := x - x1;   { Distance en nombre de colonnes }
      DeltaY := y - y1;   { Distance en nombre de lignes }

      {-- Si le curseur se trouve à l'intérieur de la fenêtre, il doit  -}
      {-- aussi être déplacé                                            -}

      if ( (x1 <= vColonne ) and (x2 >= vColonne ) and
           (y1 <= vLigne ) and (y2 >= vLigne ) ) then
        WinSetCursor( vColonne - x1 + x, vLigne - y1 + y );

      {-- En mode Write2View, la position d'affichage pour Write et ------}
      {-- Writeln doit être recalée -------}

      if ( Write2View ) then { Est-on en mode Write2View ? }
        begin
          dec( WritelnX, x1 - x );
          dec( WritelnY, y1 - y );
          WritelnPtr := GetVioPtr( WritelnX, WritelnY );
        end;

      x1 := x;    { Fixe les nouvelles coordonnées de la fenêtre }
      x2 := x + Largeur - 1;
      y1 := y;
      y2 := y + Hauteur - 1;

      GetScr( x, y, x2, y2, @Buffer ); { Mémorise la zone recouverte }
      PutScr( x, y, x2, y2, BufPtr );  { Puis affiche la nouvelle fenêtre }

      FreeMem( BufPtr, BufLen ); { Libère le buffer temporaire }
    end;
  inc( ViewX1, DeltaX );  { Déplace la zone de visualisation  }
  inc( ViewX2, DeltaX );
  inc( ViewY1, DeltaY );
  inc( ViewY2, DeltaY );
end;
{***************************************************************************
*  WinInFront : ramène une fenêtre au premier plan                         *
*                                                                          *
**------------------------------------------------------------------------**
*  Entrée : Key = Numéro de la fenêtre qui lui a été attribué par          *
*                  l'une des fonctions WinOpen ou WinOpenShadow            *
*  Sorties: True, si bon déroulement                                       *
*           False, si pas assez de mémoire                                 *
*  Variables globales : LigneOfs/R, ActWinPtr/RW, FirstWinPtr/RW, NbLig/R, *
*            NbCol/R                                                       *
***************************************************************************}

function WinInFront( Key : integer ) : boolean;

var DummyWD : WINDES;  { Descripteur fictif }
RunWiP,   { Pointe sur la liste des fenêtres }
    WiP     : WIPTR;  { Pointe sur la fenêtre à traiter }
    TempBuf,    { Buffer temporaire pour stocker une fenêtre }
    WinBuf,     { Copie de la mémoire vidéo }
    WinNrBuf,   { Contenu de la fenêtre à traiter }
    VioCopy,    { Pointe sur la copie la mémoire vidéo }
    Ancien,      { Pointe sur un buffer d'écran de travail }
    Nouveau  : VPTR;  { Pointe sur le buffer du nouvel écran }
    Nr,  { Numéro de la fenêtre à traiter dans la liste }
    TempLen,    { Taille du buffer temporaire }
    VioLen,     { Nombre d'octets de la mémoire vidéo }
    AwiLen,     { Taille de la fenêtre à traiter }
    i, j    : integer;   { Compteurs }

{-- les procédures locales Get et Put opèrent sur les différents }
{ buffers qui émulent la mémoire vidéo --}

procedure Get( x1, y1, x2, y2 : byte; VioPtr, BufPtr : pointer );

var nbytes : integer;   { Nombre d'octets à copier par ligne }

begin
  nbytes := ( x2 - x1 + 1 ) shl 1;  { Octets par ligne }
  inc( PTRREC( VioPtr ).Ofs, (x1 + y1 * NbCol) shl 1 );
  while y1 <= y2 do  { Parcourt les lignes }
    begin
      Move( VioPtr^, BufPtr^, nbytes);
      inc( PTRREC( VioPtr ).Ofs, LigneOfs );
      inc( PTRREC( BufPtr ).Ofs, nbytes );
      inc( y1 );  { Passe à la ligne suivante }
    end;
end;

procedure Put( x1, y1, x2, y2 : byte; VioPtr, BufPtr : pointer );

var nbytes : integer;   { Nombre d'octets à copier par ligne }

begin
  nbytes := ( x2 - x1 + 1 ) shl 1;  { Octets par ligne }
  inc( PTRREC( VioPtr ).Ofs, (x1 + y1 * NbCol) shl 1 );
  while y1 <= y2 do   { Parcourt les lignes }
    begin
      Move( BufPtr^, VioPtr^, nbytes );
      inc( PTRREC( VioPtr ).Ofs, LigneOfs );
      inc( PTRREC( BufPtr ).Ofs, nbytes );
      inc( y1 );  { Passe à la ligne suivante }
    end;
end;

{--------------------------------------------------------------------------}

begin

  {-- WiP va pointer sur la fenêtre à traiter ---------------}

  WiP := FirstWinPtr;   { WiP pointe d'abord sur la 1re fenêtre}
  Nr := 0;              { qui porte le numéro 0 }
  while WiP^.Handle <> Key do    { Est-ce le bon numéro ? }
    begin  { Non }
      WiP := WiP^.NextWin;   { Passe à la fenêtre suivante }
      inc( Nr );     { Incrémente le numéro }
    end;

  if ( WiP = ActWinPtr ) then { La fenêtre est-elle déjà au premier plan ? }
    begin  { Oui, c'est terminé }
      WinInFront := TRUE;
      exit;
    end;

  {-- Alloue 5 buffers pour stocker des parties de la mémoire vidéo  . ---}
  {-- ( deux d'entre eux ne seront utilisés que plus tard ) --}


  VioLen := NbLig * NbCol shl 1; { Nombres d'octets de la mémoire vidéo }
  if MaxAvail <= VioLen * 5 then  { Assez de place pour 5 buffers ? }
    begin  { Non }
      WinInFront := false;  { Signale une erreur }
      exit;  { et retourne à l'appelant }
    end;

  {-- Il reste de la place sur le tas, on reporte la position du curseur --}
  {-- et la zone de visualisation dans le descripteur de la fenêtre active }
  DummyWD := Wip^;   { Mémorise le descripteur actuel }

  Wip^.curc   := vColonne;
  Wip^.curl   := vLigne;
  Wip^.ViewX1 := ViewX1;
  Wip^.ViewY1 := ViewY1;
  Wip^.ViewX2 := ViewX2;
  Wip^.ViewY2 := ViewY2;

  {-- Fixe la position du curseur et la zone de visualisation de la nouvelle fenêtre -- }
  with Wip^.NextWin^ do
    begin
      WinSetView( ViewX1, ViewY1, ViewX2, ViewY2 );
      WinSetCursor( curc, curl );
    end;

  {-- Reporte des données de la fenêtre à traiter dans son successeur------}
  {-- actuel ------}

  with Wip^.NextWin^ do
    begin
      ViewX1 := DummyWD.ViewX1;
      ViewY1 := DummyWD.ViewY1;
      ViewX2 := DummyWD.ViewX2;
      ViewY2 := DummyWD.ViewY2;
      curc   := DummyWD.curc;
      curl   := DummyWD.curl;
    end;

  GetMem( Nouveau,  VioLen);  { Buffer servant à construire le nouvel écran }
  GetMem( Ancien,   VioLen);  { Buffer servant à travailler sur les fenêtres }
  GetMem( VioCopy, VioLen);  { Copie de la mémoire d'écran }

  {-- Copie le contenu de la mémoire vidéo dans les buffers VioCopy et Nouveau  }

  GetScr( 0, 0, NbCol-1, NbLig-1, VioCopy );
  Move( VioCopy^, Nouveau^, VioLen ); { Sauvegarde du contenu de la RAM Video }

  {-- Ferme toutes les fenêtres situées au-dessus de la fenêtre de travail dans le buffer Nouveau -- }

  RunWip := ActWinPtr;  { Pointe sur la fenêtre active (=la dernière) }
  for i:=NbWin-1 downto Nr+1 do  { Parcourt les fenêtres }
    with RunWiP^ do
      begin
        Put( x1, y1, x2, y2, Nouveau, @Buffer );
        RunWiP := LastWin; { Pointe sur la fenêtre précédente }
      end;

  {-- Stocke le contenu de la fenêtre à traiter dans un buffer séparé désigné par WinNrBuf --}

  with WiP^ do
    begin
      if ( ( Attribut and WIN_OMBRE ) <> 0 ) then
        begin  { Ne pas recopier l'ombre }
          AwiLen := (x2-x1+1-ShadowX) * (y2-y1+1-ShadowY) shl 1; { Taille du buffer }
          GetMem( WinNrBuf, AwiLen );  { Réserve de la place }
          Get( x1, y1, x2-ShadowX, y2-ShadowY, Nouveau, WinNrBuf );
          Put( x1, y1, x2, y2, Nouveau, @Buffer );  { Efface la fenêtre }
        end
      else  { Il n'y a pas d'ombre, donc recopie intégrale }
        begin
          AwiLen := (x2 - x1 + 1) * (y2 - y1 + 1) shl 1; { Taille du buffer }
          GetMem( WinNrBuf, AwiLen ); { Réserve de la place }
          Get( x1, y1, x2, y2, Nouveau, WinNrBuf ); { Transfère le contenu de la fenêtre dans le buffer }
          Put( x1, y1, x2, y2, Nouveau, @Buffer ); { Efface la fenêtre }       end;
    end;

  {-- Amène les fenêtres situées au-dessus de la fenêtre à traiter
   dans le buffer Nouveau et stocke le contenu situé en-dessous }

  for i:=Nr+1 to NbWin-1 do  { Parcourt les fenêtres }
    begin
      Move( VioCopy^, Ancien^, VioLen );  { Copie la mémoire vidéo dans le buffer Ancien }
      RunWiP := ActWinPtr;  { WiP pointe sur la dernière fenêtre }

      {-- Efface dans le buffer Ancien les fenêtres situées au-dessus de la fenêtre i ----------}
      for j:=NbWin-1 downto i+1 do
        with RunWiP^ do
          begin
            Put( x1, y1, x2, y2, Ancien, @Buffer );  { Efface la fenêtre }
            RunWiP := LastWin; { WiP pointe sur la précédente }
          end;

      {-- Recherche dans le buffer Nouveau le contenu situé au-dessous de--}
      {-- la fenêtre i et copie ensuite la fenêtre i dans le buffer Nouveau }

      with RunWiP^ do
        begin
          Get( x1, y1, x2, y2, Nouveau, @Buffer );  { Contenu au-dessous de la fenêtre }

          {-- Si la fenêtre possède une ombre, il faut la recalculer }

          if ( ( Attribut and WIN_OMBRE ) <> 0 ) then
            begin   { Reconstitue l'ombre }
              TempLen := ( x2-x1+1-ShadowX ) * ( y2-y1+1-ShadowY ) shl 1;
              GetMem( TempBuf, TempLen ); { Alloue un buffer temporaire }
              Get( x1, y1, x2 - ShadowX, y2 - ShadowY, Ancien, TempBuf );
              Put( x1, y1, x2 - ShadowX, y2 - ShadowY, Nouveau, TempBuf );
              WinShadow( x2-ShadowX+1, y1+ShadowY, x2, y2, Nouveau );
              WinShadow( x1+ShadowX, y2-ShadowY+1, x2-ShadowX, y2, Nouveau );
            end
          else  { Pas d'ombre à reconstituer }
            begin
              TempLen := (x2 - x1 + 1) * (y2 - y1 + 1) shl 1;
              GetMem( TempBuf, TempLen ); { Alloue un buffer temporaire }
              Get( x1, y1, x2, y2, Ancien, TempBuf );
              Put( x1, y1, x2, y2, Nouveau, TempBuf );
            end;
          FreeMem( TempBuf, TempLen );  { Libère le buffer temporaire }
        end;
    end;


  {-- Note le contenu situé en-dessous de la nouvelle première fenêtre et transfère cette fenêtre dans le buffer Nouveau }

  with WiP^ do
    begin
      Get( x1, y1, x2, y2, Nouveau, @Buffer );
      if ( ( Attribut and WIN_OMBRE ) <> 0 ) then
        begin  { Il y a une ombre à recalculer }
          Put( x1, y1, x2-ShadowX, y2-ShadowY, Nouveau, WinNrBuf );
          WinShadow( x2-ShadowX+1, y1+ShadowY, x2, y2, Nouveau );
          WinShadow( x1+ShadowX, y2-ShadowY+1, x2-ShadowX, y2, Nouveau );
        end
      else  { Pas d'ombre }
        Put( x1, y1, x2, y2, Nouveau, WinNrBuf );
    end;

  {-- Déplace le descripteur de la fenêtre traitée à la fin de la liste chaînée -}

  Wip^.NextWin^.LastWin := WiP^.LastWin;
  if WiP = FirstWinPtr then  { Est-ce que WIP était la première fenêtre ? }
    FirstWinPtr := WiP^.NextWin  { Oui, c'est son successeur qui va être en première position }
  else  { Non, WIP a encore un successeur }
    Wip^.LastWin^.NextWin := WiP^.NextWin;

  Wip^.NextWin := nil;   { Plus de fenêtre après WIP }
  Wip^.LastWin := ActWinPtr;  { le prédécesseur est l'ancienne fenêtre courante }
  ActWinPtr^.NextWin := WiP;   { qui pointe maintenant sur WIP  }
  ActWinPtr := WiP;
  ActBufPtr := @Wip^.Buffer;

  {-- Affiche le nouvel écran --}

  PutScr( 0, 0, NbCol-1, NbLig-1, Nouveau );

  {-- Libère les buffers alloués    }

  FreeMem( WinNrBuf, AwiLen );
  FreeMem( Nouveau,  VioLen);
  FreeMem( Ancien,   VioLen);
  FreeMem( VioCopy, VioLen);

  WinInFront := TRUE;        { Tout est bien qui finit bien }
end;